10 '    *** (FFT06.01) FFT/INV FFT ***

11 '    THIS PROGRAM ILLUSTRATES GIBBS PHENOMENON/SPECTRUM TRUNCATION

12 SCREEN 9, 1: COLOR 15, 1

13 CLS : PRINT : PRINT "INPUT NUMBER OF DATA POINTS AS 2^N"

14 INPUT "N = "; N

16 Q = 2 ^ N: Q1 = Q - 1: N1 = N - 1

18 Q2 = Q / 2: Q3 = Q2 - 1: Q4 = Q / 4: Q5 = Q4 - 1: Q8 = Q / 8

20 DIM C(Q), S(Q), KC(Q), KS(Q)

22 X0 = 50: Y0 = 200: XSF = 500 / Q: YSF = 1024: IOFLG = 1

23 PI = 3.141592653589793#: P2 = 2 * PI: K1 = P2 / Q: PI2 = P2



24 '  **** TWIDDLE FACTOR TABLE GENERATION ****

26 FOR I = 0 TO Q: KC(I) = COS(K1 * I): KS(I) = SIN(K1 * I)

28 IF ABS(KC(I)) < .0000005 THEN KC(I) = 0 ' CLEAN UP TABLES

30 IF ABS(KS(I)) < .0000005 THEN KS(I) = 0

32 NEXT I

34 FOR I = 1 TO Q1: INDX = 0

36 FOR J = 0 TO N1

38 IF I AND 2 ^ J THEN INDX = INDX + 2 ^ (N1 - J)

40 NEXT J

42 IF INDX > I THEN SWAP KC(I), KC(INDX): SWAP KS(I), KS(INDX)

44 NEXT I

45 '  ****  PRINT MAIN MENU  ****

46 CLS

50 PRINT SPC(30); "MAIN MENU": PRINT : PRINT

52 PRINT SPC(5); "1 = GENERATE STEP FUNCTION & TRANSFORM": PRINT

54 PRINT SPC(5); "2 = FORWARD TRANSFORM": PRINT

56 PRINT SPC(5); "3 = MODIFY SPECTRUM": PRINT

58 PRINT SPC(5); "4 = INVERSE TRANSFORM": PRINT

60 PRINT SPC(5); "5 = MODIFY SYSTEM": PRINT

62 PRINT SPC(5); "6 = EXIT": PRINT

70 PRINT SPC(10); "MAKE SELECTION :";

80 A$ = INKEY$: IF A$ = "" THEN 80

90 A = VAL(A$): ON A GOSUB 600, 160, 1000, 170, 180, 990

95 GOTO 46



100 '     ****  FFT ROUTINE  ****

106 T9 = TIMER

110 REM *** FFT ROUTINE ***

112 FOR M = 0 TO N1: QT = 2 ^ (N - M): QT1 = QT - 1

114 QT2 = QT / 2: QT3 = QT2 - 1: KT = 0

116 REM *** UNIVERSAL BUTTERFLY ***

118 FOR J = 0 TO Q1 STEP QT: KT2 = KT + 1

120 FOR I = 0 TO QT3: J1 = I + J: K = J1 + QT2

122 CTEMP = (C(J1) + C(K) * KC(KT) - K6 * S(K) * KS(KT)) / SK1

124 STEMP = (S(J1) + K6 * C(K) * KS(KT) + S(K) * KC(KT)) / SK1

126 CTEMP2 = (C(J1) + C(K) * KC(KT2) - K6 * S(K) * KS(KT2)) / SK1

128 S(K) = (S(J1) + K6 * C(K) * KS(KT2) + S(K) * KC(KT2)) / SK1

130 C(K) = CTEMP2: C(J1) = CTEMP: S(J1) = STEMP

132 NEXT I

134 KT = KT + 2: NEXT J

136 NEXT M

140 ' ***  BIT REVERSAL FOR FINAL DATA ***

142 FOR I = 1 TO Q1: INDX = 0

144 FOR J = 0 TO N1

146 IF I AND 2 ^ J THEN INDX = INDX + 2 ^ (N1 - J)

148 NEXT J

150 IF INDX > I THEN SWAP C(I), C(INDX): SWAP S(I), S(INDX)

152 NEXT I

154 GOTO 200



    '   *** FORWARD FFT ***

160 K6 = -1: SK1 = 2

162 CLS : HDR$ = "FREQ   F(COS)       F(SIN)       "

164 HDR$ = HDR$ + "FREQ   F(COS)       F(SIN)": PRINT : PRINT

166 GOSUB 100

168 RETURN



    '   *** INVERSE TRANSFORM ***

170 SK1 = 1: K6 = 1: YSF = 64

172 CLS : HDR$ = "TIME    AMPLITUDE   NOT USED     "

174 HDR$ = HDR$ + "TIME   AMPLITUDE     NOT USED": PRINT : PRINT

176 GOSUB 100

178 RETURN



    ' ***   MODIFY SYSTEM PARAMETERS   ***

180 CLS

182 INPUT "PRESENT DATA GRAPHICALLY? (Y/N):"; A$

184 IF A$ = "Y" OR A$ = "y" THEN IOFLG = 1 ELSE IOFLG = -1

186 RETURN



    '   *****  OUTPUT DATA  *****

200 T9 = TIMER - T9

202 IF IOFLG = 1 THEN 250

206 ZSTP = 15

208 PRINT HDR$: PRINT : PRINT

210 FOR Z = 0 TO Q2 - 1

215 GOSUB 300

216 IF Z > ZSTP THEN 350 ' PRINT 1 SCREEN AT A TIME

220 NEXT Z

222 LOCATE 1, 1: PRINT : PRINT "TIME ="; T9

225 INPUT "C/R TO CONTINUE:"; A$

229 RETURN



250    '   *** PLOT OUTPUT ***

252 CLS : YPX = 0: IF K6 = -1 THEN 280

254 Y0 = 175

256 FOR I = 0 TO Q - 1

258 IF C(I) > YPX THEN YPX = C(I)

260 NEXT I

262 YSF = 100 / YPX

263 LINE (X0 + 10, Y0 - 100)-(X0, Y0 - 100)

264 LOCATE 6, 1: PRINT USING "###.##"; YPX

265 LINE (X0 - 1, 50)-(X0 - 1, 300)

266 LINE (X0, Y0)-(X0 + 500, Y0)

268 LINE (X0, Y0)-(X0, Y0)



270 FOR I = 0 TO Q - 1

272 YP = C(I)

274 IF K6 = -1 THEN YP = SQR(C(I) ^ 2 + S(I) ^ 2)

276 LINE -(X0 + XSF * I, Y0 - YSF * YP)

278 NEXT I

279 GOTO 222

280 ' ***   FIND Y SCALE FACTOR FOR FREQ DOMAIN PLOT   ***

281 Y0 = 300 ' SET Y AXIS ORIGIN

282 FOR I = 0 TO Q - 1 ' FIND LARGEST VALUE IN ARRAY

284 YP = SQR(C(I) ^ 2 + S(I) ^ 2): IF YP > YPX THEN YPX = YP

286 NEXT I

287 YSF = 200 / YPX ' SET SCALE FACTOR

288 LINE (X0 + 10, Y0 - 200)-(X0, Y0 - 200)

289 LOCATE 8, 1: PRINT USING "###.##"; YPX: GOTO 265



300 PRINT USING "###"; Z; : PRINT "   ";

310 PRINT USING "+##.#####"; C(Z); : PRINT "    ";

312 PRINT USING "+##.#####"; S(Z); : PRINT "      ";

320 PRINT USING "###"; Z + Q2; : PRINT "   ";

322 PRINT USING "+##.#####"; C(Z + Q2); : PRINT "    ";

324 PRINT USING "+##.#####"; S(Z + Q2)

330 RETURN



350 '   *** STOP WHEN SCREEN FULL ***

352 ZSTP = ZSTP + 16

354 PRINT : INPUT "C/R TO CONTINUE:"; A$

356 CLS : PRINT HDR$: PRINT : PRINT

358 GOTO 220



600 '   * SQUARE FUNCTION *

602 CLS : PRINT : PRINT

604 PRINT "PREPARING DATA INPUT - PLEASE WAIT!"

610 FOR I = 0 TO Q / 2 - 1

620 C(I) = -1: S(I) = 0

630 NEXT

640 FOR I = Q / 2 TO Q - 1

650 C(I) = 1: S(I) = 0

660 NEXT

680 GOSUB 160

690 RETURN



'      ***************************************

990 STOP: END



1000 '   ***************************************

1002 '   *           MODIFY SPECTRUM           *

1004 '   ***************************************

1040 CLS : RTFLG = 0

1042 IF K6 <> -1 THEN 1096

1050 PRINT SPC(30); "MODIFY SPECTRUM MENU": PRINT : PRINT

1060 PRINT SPC(5); "1 = TRUNCATE SPECTRUM": PRINT

1062 PRINT SPC(5); "2 = BUTTERWORTH RESPONSE": PRINT

1064 PRINT SPC(5); "3 = GAUSSIAN RESPONSE": PRINT

1068 PRINT SPC(5); "6 = EXIT": PRINT

1070 PRINT SPC(10); "MAKE SELECTION :";

1080 A$ = INKEY$: IF A$ = "" THEN 1080

1082 A = VAL(A$): ON A GOSUB 1100, 1200, 1300, 1990, 1990, 1990

1084 GOSUB 200

1088 IF RTFLG = 1 THEN RETURN

1090 GOTO 1040

1096 INPUT "MUST TRANSFORM SIGNAL BEFORE MODIFYING SPECTRUM"; A$

1098 RETURN



1100 '   * TRUNCATE SPECTRUM *

1102 CLS : PRINT : PRINT

1104 INPUT "ENTER CUTOFF FREQUENCY"; A$

1110 FC0 = VAL(A$): IF FC0 = 0 OR FC0 > Q3 THEN 1104

1130 FOR I = FC0 TO Q - FC0

1140 C(I) = 0: S(I) = 0

1150 NEXT I

1194 RTFLG = 1: RETURN



1200 '   * BUTTERWORTH RESPONSE *

1202 CLS : PRINT : PRINT

1204 PRINT "ENTER THE 3db CUTOFF HARMONIC NUMBER (1 TO "; Q3; ")";

1206 INPUT A$

1208 FC0 = VAL(A$): IF FC0 = 0 OR FC0 > Q3 THEN 1204

1210 NP = 7: REM NUMBER OF POLES = NP

1220 FOR I = 1 TO Q3

1222 ATTN = 1 / SQR(1 + (I / FC0) ^ (2 * NP))

1224 C(I) = ATTN * C(I): S(I) = ATTN * S(I)

1226 C(Q - I) = ATTN * C(Q - I): S(Q - I) = ATTN * S(Q - I)

1228 NEXT I

1230 ATTN = 1 / SQR(1 + (Q2 / FC0) ^ (2 * NP))

1234 C(Q2) = ATTN * C(Q2)

1294 RTFLG = 1: RETURN



1300 '   * GAUSSIAN RESPONSE *

1302 CLS : PRINT : PRINT

1304 PRINT "ENTER THE 3db CUTOFF HARMONIC NUMBER (1 TO "; Q3; ")";

1306 INPUT A$

1308 FC0 = VAL(A$): IF FC0 = 0 OR FC0 > Q3 THEN 1304

1320 FOR I = 1 TO Q3

1322 ATTN = 1 / SQR(EXP(.3 * ((I / FC0) ^ 2)))

1324 C(I) = ATTN * C(I): S(I) = ATTN * S(I)

1326 C(Q - I) = ATTN * C(Q - I): S(Q - I) = ATTN * S(Q - I)

1328 NEXT I

1330 ATTN = 1 / SQR(EXP(.3 * ((Q2 / FC0) ^ 2)))

1334 C(Q2) = ATTN * C(Q2): S(Q2) = ATTN * S(Q2)

1394 RTFLG = 1: RETURN



1990 '   * EXIT MODIFY SPECTRUM ROUTINE *

1992 RTFLG = 1: RETURN





